home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / lib / perl5 / 5.00503 / AutoLoader.pm next >
Encoding:
Perl POD Document  |  2000-01-12  |  3.8 KB  |  139 lines
  1. package AutoLoader;
  2.  
  3. use vars qw(@EXPORT @EXPORT_OK);
  4.  
  5. my $is_dosish;
  6. my $is_vms;
  7.  
  8. BEGIN {
  9.     require Exporter;
  10.     @EXPORT = ();
  11.     @EXPORT_OK = qw(AUTOLOAD);
  12.     $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32';
  13.     $is_vms = $^O eq 'VMS';
  14. }
  15.  
  16. AUTOLOAD {
  17.     my $name;
  18.     # Braces used to preserve $1 et al.
  19.     {
  20.     # Try to find the autoloaded file from the package-qualified
  21.     # name of the sub. e.g., if the sub needed is
  22.     # Getopt::Long::GetOptions(), then $INC{Getopt/Long.pm} is
  23.     # something like '/usr/lib/perl5/Getopt/Long.pm', and the
  24.     # autoload file is '/usr/lib/perl5/auto/Getopt/Long/GetOptions.al'.
  25.     #
  26.     # However, if @INC is a relative path, this might not work.  If,
  27.     # for example, @INC = ('lib'), then $INC{Getopt/Long.pm} is
  28.     # 'lib/Getopt/Long.pm', and we want to require
  29.     # 'auto/Getopt/Long/GetOptions.al' (without the leading 'lib').
  30.     # In this case, we simple prepend the 'auto/' and let the
  31.     # C<require> take care of the searching for us.
  32.  
  33.     my ($pkg,$func) = $AUTOLOAD =~ /(.*)::([^:]+)$/;
  34.     $pkg =~ s#::#/#g;
  35.     if (defined($name=$INC{"$pkg.pm"})) {
  36.         $name =~ s#^(.*)$pkg\.pm$#$1auto/$pkg/$func.al#;
  37.  
  38.         # if the file exists, then make sure that it is a
  39.         # a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al',
  40.         # or './lib/auto/foo/bar.al'.  This avoids C<require> searching
  41.         # (and failing) to find the 'lib/auto/foo/bar.al' because it
  42.         # looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib').
  43.  
  44.         if (-r $name) {
  45.             unless ($name =~ m|^/|) {
  46.             if ($is_dosish) {
  47.             unless ($name =~ m{^([a-z]:)?[\\/]}i) {
  48.                  $name = "./$name";
  49.             }
  50.             }
  51.             elsif ($is_vms) {
  52.                 # XXX todo by VMSmiths
  53.             $name = "./$name";
  54.             }
  55.             else {
  56.             $name = "./$name";
  57.             }
  58.         }
  59.         }
  60.         else {
  61.         $name = undef;
  62.         }
  63.     }
  64.     unless (defined $name) {
  65.         # let C<require> do the searching
  66.         $name = "auto/$AUTOLOAD.al";
  67.         $name =~ s#::#/#g;
  68.     }
  69.     }
  70.     my $save = $@;
  71.     eval { local $SIG{__DIE__}; require $name };
  72.     if ($@) {
  73.     if (substr($AUTOLOAD,-9) eq '::DESTROY') {
  74.         *$AUTOLOAD = sub {};
  75.     } else {
  76.         # The load might just have failed because the filename was too
  77.         # long for some old SVR3 systems which treat long names as errors.
  78.         # If we can succesfully truncate a long name then it's worth a go.
  79.         # There is a slight risk that we could pick up the wrong file here
  80.         # but autosplit should have warned about that when splitting.
  81.         if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
  82.         eval {local $SIG{__DIE__};require $name};
  83.         }
  84.         if ($@){
  85.         $@ =~ s/ at .*\n//;
  86.         my $error = $@;
  87.         require Carp;
  88.         Carp::croak($error);
  89.         }
  90.     }
  91.     }
  92.     $@ = $save;
  93.     goto &$AUTOLOAD;
  94. }
  95.  
  96. sub import {
  97.     my $pkg = shift;
  98.     my $callpkg = caller;
  99.  
  100.     #
  101.     # Export symbols, but not by accident of inheritance.
  102.     #
  103.  
  104.     Exporter::export $pkg, $callpkg, @_ if $pkg eq 'AutoLoader';
  105.  
  106.     #
  107.     # Try to find the autosplit index file.  Eg., if the call package
  108.     # is POSIX, then $INC{POSIX.pm} is something like
  109.     # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in
  110.     # '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that.
  111.     #
  112.     # However, if @INC is a relative path, this might not work.  If,
  113.     # for example, @INC = ('lib'), then
  114.     # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require
  115.     # 'auto/POSIX/autosplit.ix' (without the leading 'lib').
  116.     #
  117.  
  118.     (my $calldir = $callpkg) =~ s#::#/#g;
  119.     my $path = $INC{$calldir . '.pm'};
  120.     if (defined($path)) {
  121.     # Try absolute path name.
  122.     $path =~ s#^(.*)$calldir\.pm$#$1auto/$calldir/autosplit.ix#;
  123.     eval { require $path; };
  124.     # If that failed, try relative path with normal @INC searching.
  125.     if ($@) {
  126.         $path ="auto/$calldir/autosplit.ix";
  127.         eval { require $path; };
  128.     }
  129.     if ($@) {
  130.         my $error = $@;
  131.         require Carp;
  132.         Carp::carp($error);
  133.     }
  134.     } 
  135. }
  136.  
  137. 1;
  138.  
  139.